home *** CD-ROM | disk | FTP | other *** search
/ Delphi Informant Complete 1995 - 2000 / Delphi Informant Complete 1995 to 2000.iso / Delphi Informant Magazine Complete Works SOURCE CODE 1995.rar / 1995 / DEC / DI9512DF / cardu.pas < prev    next >
Pascal/Delphi Source File  |  1995-10-14  |  10KB  |  334 lines
  1. unit Cardu;
  2.  
  3. interface
  4.  
  5. uses WinTypes, WinProcs, Classes, Graphics, Forms,
  6.      Controls, StdCtrls, SysUtils, Dialogs, mmSystem, ExtCtrls, Carddeck,
  7.   Buttons;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     DealOrDraw: TButton;
  12.     Hold1: TLabel;
  13.     Hold2: TLabel;
  14.     Hold3: TLabel;
  15.     Hold4: TLabel;
  16.     Hold5: TLabel;
  17.     HoldButton1: TButton;
  18.     HoldButton2: TButton;
  19.     HoldButton3: TButton;
  20.     HoldButton4: TButton;
  21.     HoldButton5: TButton;
  22.     Timer1: TTimer;
  23.     HoldOrDraw: TLabel;
  24.     Shape1: TShape;
  25.     Pot: TLabel;
  26.     CardDeck1: TCardDeck;
  27.     CardDeck2: TCardDeck;
  28.     CardDeck3: TCardDeck;
  29.     CardDeck4: TCardDeck;
  30.     CardDeck5: TCardDeck;
  31.     Label1: TLabel;
  32.     Label2: TLabel;
  33.     Label3: TLabel;
  34.     Label4: TLabel;
  35.     Label5: TLabel;
  36.     Label6: TLabel;
  37.     Label7: TLabel;
  38.     Label8: TLabel;
  39.     Label9: TLabel;
  40.     Label10: TLabel;
  41.     Label11: TLabel;
  42.     Label12: TLabel;
  43.     Label13: TLabel;
  44.     Label14: TLabel;
  45.     Label15: TLabel;
  46.     Label16: TLabel;
  47.     SoundButton: TBitBtn;
  48.  
  49.     procedure DealOrDrawClick(Sender: TObject);
  50.     procedure FormCreate(Sender: TObject);
  51.     procedure HoldButton1Click(Sender: TObject);
  52.     procedure SoundButtonClick(Sender: TObject);
  53.     procedure Timer1Timer(Sender: TObject);
  54.  
  55.   private
  56.     { Private declarations }
  57.  
  58.   public
  59.     { Public declarations }
  60.   end;
  61.  
  62. Type
  63.     TCardHand = array[1..5] of byte;
  64.  
  65. var
  66.   Form1: TForm1;
  67.   aUsedCards: array[1..52] of Boolean; {has this card been dealt yet}
  68.   aUsedTag: array[1..5] of Boolean;    {has this card contributed to score yet}
  69.   bFirstDeal: Boolean;                 {is this the opening deal or second deal}
  70.   aHand: TCardHand;                    {cards in current hand}
  71.   iWinnings: Longint;                  {loot from last winning hand}
  72.   bBlinker: Boolean;                   {controls blinking of winning cards}
  73.   bNextSong: Boolean;                  {tracks which song to play on a win}
  74.   bSound: Boolean;                     {is sound turned on}
  75.   bJustWon: Boolean;                   {did the user just win a hand}
  76.  
  77. implementation
  78.  
  79. {$R *.DFM}
  80.  
  81. procedure TForm1.DealOrDrawClick(Sender: TObject);
  82. var
  83.    x,y,z:byte;          {general purpose}
  84.    iCurrentCount:byte;  {number of matching cards in current hand}
  85.    iCardCount:byte;      {used to step through all 52 cards}
  86.    bTwoOfAKind,          {does the player have two of a kind}
  87.    bTwoPair,             {does the player have two pair}
  88.    bThreeOfAKind,        {does the player have three of a kind}
  89.    bFourOfAKind,         {does the player have four of a kind}
  90.    bJacksOrBetter,       {does the player have a pair of jacks or better}
  91.    bFlush,               {does the player have a flush}
  92.    bStraight,            {does the player have a straight}
  93.    bStraightFlush,       {does the player have a straight flush}
  94.    bFullHouse,           {does the player have a full house}
  95.    bRoyalFlush: Boolean; {is this a really lucky player}
  96.    aFaceCopy: TCardHand; {a copy of the current hand}
  97.  
  98. begin
  99.  
  100. if bSound then
  101.   sndPlaySound('Deal.wav',3);
  102.  
  103. Timer1.enabled:=False;
  104.  
  105. if iWinnings<>0 then begin
  106.   Pot.caption:=IntToStr(StrToInt(Pot.caption)+iWinnings);
  107.   iWinnings:=0;
  108. end;
  109.  
  110. if bFirstDeal and (StrToInt(Pot.caption)=0) then begin
  111.   MessageDlg('Busted, You have no money left to bet!', mtWarning,[mbOK], 0);
  112.   exit;
  113. end;
  114.  
  115. if bFirstDeal then
  116. begin
  117.   for x:=1 to 52 do        {initilize deck to no cards used yet}
  118.     aUsedCards[x]:=False;
  119.  
  120.   DealOrDraw.Caption:='&Draw';
  121.   HoldOrDraw.Caption:='Hold or Draw';
  122.   Pot.caption:=IntToStr(StrToInt(Pot.caption)-5);
  123.   {Pick out 5 new cards}
  124.   for iCardCount:=1 to 5 do
  125.     begin
  126.       TButton(FindComponent('HoldButton'+inttostr(iCardCount))).enabled:=True;
  127.       TLabel(FindComponent('Hold'+inttostr(iCardCount))).visible:=False;
  128.       repeat {Pick a random card}
  129.         x:=random(51)+1;
  130.       until not aUsedCards[x]; {maybe not the best way but it gets the job done}
  131.       TCardDeck(FindComponent('CardDeck'+inttostr(iCardCount))).value:=x;
  132.       if bSound then sndPlaySound('CARD.WAV',2);
  133.       aUsedCards[x]:=True;
  134.       aHand[iCardCount]:=x;
  135.     end;
  136.    end
  137.  else
  138.    begin
  139.      HoldOrDraw.caption:='';
  140.      for iCardCount:=1 to 5 do
  141.        begin    {deal new cards for non held cards}
  142.          TButton(FindComponent('HoldButton'+inttostr(iCardCount))).enabled:=False;
  143.          if Tlabel(FindComponent('Hold'+inttostr(iCardCount))).visible then continue;
  144.          repeat
  145.            x:=random(51)+1;
  146.          until not aUsedCards[x];
  147.          TCardDeck(FindComponent('CardDeck'+inttostr(iCardCount))).value:=x;
  148.          if bSound then sndPlaySound('CARD.WAV',2);
  149.          aUsedCards[x]:=True;
  150.          aHand[iCardCount]:=x;
  151.          Tlabel(FindComponent('Hold'+inttostr(iCardCount))).visible:=false;
  152.        end;
  153.      DealOrDraw.Caption:='&Deal';
  154.  
  155.      {Now got to score the whole thing}
  156.      bTwoOfAKind:=False;
  157.      bTwoPair:=False;
  158.      bThreeOfAKind:=False;
  159.      bFourOfAKind:=False;
  160.      bJacksOrBetter:=False;
  161.      bFlush:=True;
  162.      bStraight:=True;
  163.      bFullHouse:=False;
  164.      for x:=1 to 5 do
  165.        aUsedTag[x]:=false;
  166.  
  167.      {compare face value of each card to other cards counting matches}
  168.      for x:=1 to 5 do begin
  169.        if aUsedtag[x] then continue;
  170.        iCurrentCount:=0;
  171.        for y:=x+1 to 5 do begin
  172.          if (CardValue(aHand[x])=CardValue(aHand[y])) and (not aUsedTag[y]) then begin
  173.            aUsedTag[y]:=True;
  174.            aUsedTag[x]:=True;
  175.            inc(iCurrentCount);
  176.            if isFaceCard(aHand[x]) then bJacksOrBetter:=True;
  177.          end;
  178.        end;  {end of inner for loop}
  179.  
  180.        case  iCurrentCount of
  181.          3: bFourOfAKind:=True;
  182.          2: bThreeOfAKind:=True;
  183.          1: If bTwoOfAKind then
  184.               bTwoPair:=True
  185.             else
  186.               bTwoOfAKind:=True;
  187.        end;  {End of CurrentCount case}
  188.      end;  {End of outter loop}
  189.  
  190.      {it's a flush if CardSuit of all five cards is the same}
  191.      for x:=2 to 5 do
  192.        bFlush:= (CardSuit(aHand[1])=CardSuit(aHand[x])) and bFlush;
  193.  
  194.  
  195.      {now detect a straight, start by creating a sorted copy of hand}
  196.      {using a copy so can 'blink' winning cards}
  197.      for x:=1 to 5 do
  198.        afacecopy[x]:=CardValue(ahand[x]);
  199.  
  200.      {just a little bubble sort}
  201.      for x:= 1 to 4 do begin
  202.        for y:=x to 5 do begin
  203.          if afacecopy[y]>afacecopy[x] then begin
  204.            z:=afacecopy[x];
  205.            afacecopy[x]:=afacecopy[y];
  206.            afacecopy[y]:=z;
  207.          end;
  208.        end;
  209.      end;
  210.  
  211.      {if its a straight then each consective card will have face value of one
  212.       more than previous card}
  213.      for x:=2 to 5 do
  214.        if afacecopy[x]<>afacecopy[x-1]-1 then bStraight:=False;
  215.  
  216.  
  217.      bFullHouse:=bThreeOfAKind and bTwoOfAKind;
  218.      bStraightFlush:=bStraight and bFlush;
  219.      bRoyalFlush:=bFlush and bStraight and (CardValue(ahand[1])=14);
  220.  
  221.      if bRoyalFlush then iWinnings:=3000 else
  222.      if bStraightFlush then iWinnings:=250 else
  223.      if bFourOfAKind then iWinnings:=125 else
  224.      if bFullHouse then iWinnings:=40 else
  225.      if bFlush then iWinnings:=25 else
  226.      if bStraight then iWinnings:=20 else
  227.      if bThreeOfAKind then iWinnings:=15 else
  228.      if bTwoPair then iWinnings:=10 else
  229.      if bTwoOfAKind and bJacksOrBetter then iWinnings:=5 else iWinnings:=0;
  230.  
  231.      {if winnings are >20 then all five cards are involved, otherwise
  232.      aUsedTag is already set}
  233.      if iWinnings>=20 then
  234.        for x:=1 to 5 do
  235.          aUsedTag[x]:=True;
  236.  
  237.      {if user won then set up timer to give the user the loot and play sounds}
  238.      if boolean(iWinnings) then begin
  239.        if bSound then
  240.           sndPlaySound('Win.wav',2);
  241.        bJustWon:=True;
  242.        Timer1.Interval:=200;
  243.        Timer1Timer(Tobject(TForm1));
  244.        Timer1.enabled:=true;
  245.      end;
  246.  
  247.   end;  {End of if second hand}
  248.  
  249. bFirstDeal := not bFirstDeal;
  250. end;
  251.  
  252.  
  253. procedure TForm1.FormCreate(Sender: TObject);
  254. begin
  255. bSound:=True;
  256. bNextSong:=False;
  257. bBlinker:=False;
  258. Pot.caption:='100';
  259. Randomize;
  260. bFirstDeal:=True;
  261. end;
  262.  
  263.  
  264. procedure T